home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / schmlbrr / schem_lb.lha / unsupported / CScheme / util.scm < prev   
Encoding:
Text File  |  1991-08-05  |  1.0 KB  |  42 lines
  1. ;;; -*- Base: 10; Mode: Scheme; Syntax: MIT Scheme; Package: USER -*-
  2. ;;
  3. ;; UTIL.SCM
  4. ;;
  5. ;; Minghsun Liu
  6. ;; July 10, 1991
  7. ;;
  8. ;; Some utility to go with Cooper.Scm
  9. ;;
  10. (defmacro (tt #!rest x)
  11.   `(let ((st (runtime)))
  12.      ,@x
  13.      (- (runtime) st)))
  14.  
  15. ;;
  16. ;; (TIME X)
  17. ;;
  18. ;; try to give something similar to TIME in CL.  The time returned are
  19. ;; in milliseconds.  
  20. ;;
  21. (defmacro (time #!rest x)
  22.   `(time-aux (lambda () ,@x)))
  23.  
  24. (define (time-aux thunk)
  25.   (let ((original-gc-stat (gc-statistics))
  26.         (process-start (process-time-clock))
  27.     (real-start (real-time-clock)))
  28.     (let ((value (thunk)))
  29.       (let ((process-end (process-time-clock))
  30.         (real-end (real-time-clock)))
  31.     (newline)
  32.     (for-each 
  33.      (lambda (stat) (write-string (gc-statistic->string stat)) (newline)) 
  34.      (list-transform-negative 
  35.          (gc-statistics) 
  36.        (lambda (a) (member a original-gc-stat))))
  37.         (write-string "process time: ")
  38.         (write (- process-end process-start))
  39.         (write-string "; real time: ")
  40.         (write (- real-end real-start)))
  41.       value)))
  42.